' tinyBasic.iBas

' ---------------------------------
' tinyBasic v1.2
'   Copyleft 2005-2007 
'     by Laurent DUVEAU
'   http://www.aldweb.com/
'
' This file is an iziBasic for
' Palm sample Tiny Basic 
' interpreter, loosely adapted
' from the original Tiny Basic 
' version by Li Chen Wang.
' ---------------------------------


{CREATORID "LDtB"}
{VERSION "1.2"}
{RESOURCEFILE "tinyBasic.rsrc"}
{PARSER ON}
{SECUREFILES OFF}

' A          temp
' B          temp
' C          character index in line
' E          line number for error msg
' I          temp (loops)
' K          temp
' L          number of lines
' N          number
' S          expression stack index
' T          temp
' V          variable index

' A$         temp
' B$         temp
' C$         character
' D$         single statement
' E$         error message
' G$         string code (")
' H$         HALT code (Line Feed)
' I$-R$      Help
' Z$=A$(26)  statement input

DIM A$(125) ' [27-125] = 99 program lines
DIM A(82)   ' [27-52] = 26 variables
            ' [53-82] = 30 items math stack

CONST I$="BYE, CLEAR, CLS, END"
CONST J$="HELP, MEM, NEW, RUN"
CONST K$="GOTO | LOAD | SAVE <exp>"
CONST L$="IF <exp> THEN <statement>"
CONST M$="INPUT <var>"
CONST N$="[LET] <var>=<exp>"
CONST O$="LIST [<exp>|PAUSE]"
CONST P$="PRINT <exp|str>[,<exp|str>][;]"
CONST Q$="REM <any>"
CONST R$="Functions: TICKS, TICKSPERSEC" 

BEGIN
 G$=CHR$(34) : H$=CHR$(10)
 B=FILEEXISTS("tinyBas0")
 IF B=TRUE THEN
  Z$="load0:run"
  GOTO _AutoRun
 ENDIF
_Ready:
 IF E$<>"" THEN
  IF E>0 THEN
   E$="#Err in "+STR$(E,0)+": "+E$
  ELSE
   E$="#Err: "+E$
  ENDIF
  PRINT E$ : E$=""
 ENDIF
 PRINT "Ready" 
_Input:
 INPUT Z$ : PRINT Z$
_AutoRun:
 L=26 : C=1 : GOSUB _GetNumber : E=N
 IF N=0 THEN
  IF C$="" GOTO _Ready 
  GOTO _NextStatement
 ELSE
  B=(N>0) AND (N=INT(N))
  IF B=TRUE THEN
   GOSUB _EnterLine
   IF E$<>"" GOTO _Ready
   GOTO _Input
  ELSE
   E=0 : E$="Invalid line number"
   GOTO _Ready
  ENDIF
 ENDIF
_Exec:
 GOSUB _GetNumber : E=N
_NextStatement:
 A$=INKEY$
 IF A$=H$ THEN
  A$="Break in "+STR$(E,0)
  PRINT A$ : GOTO _Ready
 ENDIF
 GOSUB _GetLabel
 IF E$<>"" GOTO _Ready
 SELECT CASE D$
 CASE "if" 
  GOSUB _GetExpression
  IF E$<>"" GOTO _Ready
  IF N<1 THEN
   B$=A$(L) : C=LEN(B$)+1
   GOTO _FinishStatement
  ENDIF
  GOSUB _GetLabeL
  IF E$<>"" GOTO _Ready
  IF D$<>"then" THEN
   E$="'THEN' expected"
   GOTO _Ready
  ENDIF
  GOTO _NextStatement
 CASE "rem"
  B$=A$(L) : C=LEN(B$)+1
  GOTO _FinishStatement
 CASE "input"
  GOSUB _GetVar
  IF E$<>"" GOTO _Ready
  INPUT N : A(V)=N
  GOTO _FinishStatement
 CASE "print"
_Print:
  GOSUB _SkipSpace
  GOSUB _GetChar
  IF C$=G$ THEN
   B$=""
_NextChar:
   INC C : C$=MID$(A$,C,1)
   IF C$="" THEN
    E$="Unterminated string"
    GOTO _Ready
   ELSE
    IF C$<>G$ THEN
     B$=B$+C$
     GOTO _NextChar
    ENDIF
   ENDIF
   INC C : C$=MID$(A$,C,1)
   IF C$=G$ THEN
    B$=B$+C$
    GOTO _NextChar
   ENDIF
   PRINT B$;
  ELSE        
   GOSUB _GetExpression
   IF E$<>"" GOTO _Ready
   B=N\1
   IF B=N THEN
    PRINT N USING 0;
   ELSE 
    PRINT N;  
   ENDIF
  ENDIF
  GOSUB _SkipSpace
  GOSUB _GetChar
  IF C$="," INC C : GOTO _Print
  GOSUB _SkipSpace
  GOSUB _GetChar
  IF C$<>";" THEN  
   PRINT
  ELSE
   INC C
  ENDIF
  GOTO _FinishStatement 
 CASE "clear"
  FOR I=27 TO 52 : A(I)=0 : NEXT
  GOTO _FinishStatement   
 CASE "run"
  FOR I=27 TO 52 : A(I)=0 : NEXT
  L=27 : C=1
  GOTO _FinishStatement2
 CASE "goto"
  GOSUB _GetExpression 
  IF E$<>"" GOTO _Ready
  IF E>=N LET L=27
  C=1 : T=N
_NextGoto:
  IF L=126 THEN
   E$="Line not found"
   GOTO _Ready
  ENDIF
  GOSUB _GetNumber
  IF N=T LET E=N : GOTO _NextStatement
  INC L : C=1
  GOTO _NextGoto
 CASE "new"
  FOR I=27 TO 125 : A$(I)="" : NEXT
  FOR I=27 TO 52 : A(I)=0 : NEXT
  IF E=0 GOTO _FinishStatement
  GOTO _Ready
 CASE "cls" 
  CLS : GOTO _FinishStatement 
 CASE "help"
  FOR I=9 TO 18 
   B$=A$(I) : PRINT B$
  NEXT
  GOTO _FinishStatement
 CASE "mem"
  B=126
  FOR I=125 DOWNTO 27
   B$=A$(I) : IF B$="" LET B=I
  NEXT
  B=126-B : PRINT B USING 0;
  PRINT " lines free"
  GOTO _FinishStatement 
 CASE "end" 
  GOTO _Ready
 CASE "bye"  
  GOTO _ExitTinyBAS
 CASE "list"
  GOSUB _GetNumber : T=N : K=L : I=C
  IF T=0 THEN
   GOSUB _GetLabeL
   IF E$="" IF D$="pause" LET I=C
   E$=""
  ENDIF
  FOR L=27 TO 125
   C=1 : GOSUB _GetNumber
   B=(T=0) OR (N=T)
   IF B=TRUE THEN
    IF A$<>"" THEN
     PRINT A$
     IF D$="pause" THEN
      B=(L-26) MOD 10
      IF B=0 PRINT "Pause..." : WAIT
     ENDIF
    ENDIF
   ENDIF 
  NEXT
  L=K : C=I
  GOTO _FinishStatement  
 CASE "save"
  GOSUB _GetExpression
  IF E$<>"" GOTO _Ready
  A$="tinyBas"+STR$(N,0) : A=FALSE
  OPEN A$ FOR OUTPUT AS #1
  FOR I=27 TO 125
   B$=A$(I)
   IF B$<>"" PRINT #1,B$ : A=TRUE
  NEXT  
  CLOSE #1
  IF A=FALSE KILL A$
  GOTO _FinishStatement
 CASE "load"
  GOSUB _GetExpression
  IF E$<>"" GOTO _Ready
  A$="tinyBas"+STR$(N,0)
  B=FILEEXISTS(A$)
  IF B=FALSE THEN
   E$="File "+A$+" not found"
   GOTO _Ready
  ENDIF
  OPEN A$ FOR INPUT AS #1
  B=FALSE : I=27
  WHILE B=FALSE
   B=EOF(#1)
   INPUT #1,B$ : A$(I)=B$ : INC I
  WEND  
  CLOSE #1
  WHILE I<=125
   A$(I)="" : INC I
  WEND
  IF E=0 GOTO _FinishStatement
  GOTO _Ready
 CASE "let" 
  GOSUB _GetLabel
  IF E$<>"" GOTO _Ready
 END SELECT
 GOSUB _ReturnVar
 IF E$<>"" GOTO _Ready
 GOSUB _SkipSpace
 GOSUB _GetChar
 IF C$<>"=" THEN 
  E$="'=' expected"
  GOTO _Ready
 ENDIF
 INC C : T=V
 GOSUB _GetExpression
 IF E$<>"" GOTO _Ready
 A(T)=N  
_FinishStatement:
 GOSUB _SkipSpace
 GOSUB _GetChar
 IF C$=":" THEN
  INC C : GOTO _NextStatement
 ELSE
  IF C$<>"" THEN
   E$="End of statement expected"
   GOTO _Ready
  ENDIF
 ENDIF
 IF L=26 GOTO _Ready
 INC L : C=1
 IF L=126 THEN
  E$="Program Overflow"
  GOTO _Ready
 ENDIF
_FinishStatement2:
 B$=A$(L)
 IF B$="" GOTO _Ready
 GOTO _Exec
_ExitTinyBAS:
END

_EnterLine:
 L=27 : C=1 : T=N 
_NextLine:
 GOSUB _GetNumber
 B=(N<T) AND (N<>0) AND (L<126)
 IF B=TRUE THEN
  INC L : C=1 : GOTO _NextLine 
 ENDIF
 IF L=126 THEN
  E$="Program Overflow"
  GOTO _EndEnterLine
 ENDIF
 IF T<>N THEN
  FOR I=125 DOWNTO L STEP -1
   B=I-1 : A$(I)=A$(B)
  NEXT
 ENDIF
 A$(L)=Z$
 GOSUB _SkipSpace
 IF C$="" THEN
  FOR I=L TO 124
   B=I+1 : A$(I)=A$(B)
  NEXT  
 ENDIF
_EndEnterLine:
RETURN

_GetExpression:
 A(53)=0 : S=53
 GOSUB _BoolExpression
 N=A(S) : GOTO _EndExpression
_BoolExpression:
 GOSUB _AddExpression
 GOSUB _SkipSpace
 GOSUB _GetChar
_NextBool:
 SELECT CASE C$
 CASE "="
  INC C : GOSUB _AddExpression
  B=S-1 : A(B)=A(B)=A(S) : DEC S
 CASE ">"
  INC C : GOSUB _GetChar
  IF C$="=" THEN
   INC C : GOSUB _AddExpression
   B=S-1 : A(B)=A(B)>=A(S) : DEC S 
  ELSE
   GOSUB _AddExpression
   B=S-1 : A(B)=A(B)>A(S) : DEC S
  ENDIF
 CASE "<"
  INC C : GOSUB _GetChar
  SELECT CASE C$
  CASE "="
   INC C : GOSUB _AddExpression
   B=S-1 : A(B)=A(B)<=A(S) : DEC S 
  CASE ">"
   INC C : GOSUB _AddExpression
   B=S-1 : A(B)=A(B)<>A(S) : DEC S
  CASE ELSE
   GOSUB _AddExpression
   B=S-1 : A(B)=A(B)<A(S) : DEC S
  END SELECT
 END SELECT
 GOSUB _SkipSpace
 GOSUB _GetChar
 B=ASC(C$) : B=(B>=60) AND (B<=62) 
 IF B=TRUE GOTO _NextBool
 GOTO _EndExpression 
_AddExpression:
 GOSUB _MulExpression
 GOSUB _SkipSpace
 GOSUB _GetChar
_NextAdd:
 SELECT CASE C$ 
 CASE "+"
  INC C : GOSUB _MulExpression
  B=S-1 : A(B)=A(B)+A(S) : DEC S
 CASE "-" 
  INC C : GOSUB _MulExpression
  B=S-1 : A(B)=A(B)-A(S) : DEC S
 END SELECT
 GOSUB _SkipSpace
 GOSUB _GetChar
 B=ASC(C$) : B=(B=43) OR (B=45) 
 IF B=TRUE GOTO _NextAdd
 GOTO _EndExpression 
_MulExpression:
 GOSUB _GroupExpression
 GOSUB _SkipSpace
 GOSUB _GetChar
_NextMul:
 SELECT CASE C$ 
 CASE "*"
  INC C : GOSUB _GroupExpression
  B=S-1 : A(B)=A(B)*A(S) : DEC S
 CASE "/"
  INC C : GOSUB _GroupExpression
  B=A(S)
  IF B=0 THEN
   IF E$="" LET E$="Division by zero"
   DEC S : GOTO _EndExpression   
  ELSE
   B=S-1 : A(B)=A(B)/A(S) : DEC S
  ENDIF
 CASE "\"
  INC C : GOSUB _GroupExpression
  B=A(S)
  IF B=0 THEN
   IF E$="" LET E$="Division by zero"
   DEC S : GOTO _EndExpression   
  ELSE
   B=S-1 : A(B)=A(B)\A(S) : DEC S
  ENDIF
 ENDSELECT
 GOSUB _SkipSpace
 GOSUB _GetChar
 B=ASC(C$)
 B=(B=42) OR (B=47)  OR (B=92)
 IF B=TRUE GOTO _NextMul
 GOTO _EndExpression     
_GroupExpression:
 GOSUB _SkipSpace
 GOSUB _GetChar
 SELECT CASE C$
 CASE "("
  INC C : GOSUB _BoolExpression
  GOSUB _SkipSpace
  GOSUB _GetChar
  IF C$<>")" THEN
   IF E$="" LET E$="Missing ')'"
   GOTO _EndExpression
  ENDIF
  INC C      
 CASE ""
  IF E$="" LET E$="Invalid Factor"  
 CASE ELSE
  B=ASC(C$)
  B=((B<48) OR (B>57)) AND (B<>45) AND (B<>46)
  IF B=FALSE THEN
   GOSUB _GetNumber
   IF E$<>"" GOTO _EndExpression 
   INC S : A(S)=N
  ELSE 
   GOSUB _GetLabel
   IF E$<>"" GOTO _EndExpression
   B=LEN(D$)
   IF B=1 THEN
    GOSUB _ReturnVar
    INC S : A(S)=A(V)
   ELSE
    SELECT CASE D$
    CASE "ticks"
     INC S : A(S)=TICKS
    CASE "tickspersec"
     INC S : A(S)=TICKSPERSEC
    CASE ELSE
     IF E$="" LET E$="Function expected"
    ENDSELECT
   ENDIF
  ENDIF
 END SELECT
_EndExpression:
RETURN

_GetNumber:
 GOSUB _SkipSpace
 A=0
 GOSUB _GetChar
 IF C$="-" THEN
  B$="-" : INC C : GOSUB _GetChar
  B=ASC(C$)
  B=((B<48) OR (B>57)) AND (B<>46)
  IF B=TRUE GOTO _GetNumberError
 ELSE
  B$=""
 ENDIF
_NextNumber:
 IF C$="" GOTO _GetNumberCalc
 B=ASC(C$)
 IF B=46 THEN
  INC A
  IF A>1 GOTO _GetNumberError
 ENDIF
 B=((B<48) OR (B>57)) AND (B<>46) 
 IF B=TRUE GOTO _GetNumberCalc
 B$=B$+C$ : INC C : GOSUB _GetChar
 GOTO _NextNumber
_GetNumberError:
 IF E$="" LET E$="Invalid Number"
 GOTO _GetNumberExit
_GetNumberCalc:
 N=VAL(B$)
_GetNumberExit:
RETURN

_GetVar:
 GOSUB _GetLabel
 IF E$<>"" GOTO _GetVarExit
_ReturnVar:
 B=ASC(D$) : A=LEN(D$)
 A=(A<>1) OR (B<97) OR (B>122)
 IF A=FALSE THEN
  V=B-70
 ELSE
  IF E$="" LET E$="Variable expected"
 ENDIF
_GetVarExit:
RETURN

_GetLabel:
 GOSUB _SkipSpace
 GOSUB _GetChar
 D$=""
 IF C$="" GOTO _GetLabelError
 B=ASC(C$) : B=(B<97) OR (B>122)
 IF B=TRUE GOTO _GetLabelError
_GetNextLabel:
 D$=D$+C$ : INC C
 GOSUB _GetChar
 IF C$="" GOTO _GetLabelExit 
 B=ASC(C$) : B=(B>=97) AND (B<=122)
 IF B=TRUE GOTO _GetNextLabel
 GOTO _GetLabelExit
_GetLabelError:
 IF E$="" LET E$="Invalid label"
_GetLabelExit:
RETURN

_SkipSpace:
 GOSUB _GetChar
 IF C$=" " INC C : GOTO _SkipSpace
RETURN

_GetChar:
 A$=A$(L)
 C$=MID$(A$,C,1) : C$=LCASE$(C$)
RETURN
